home *** CD-ROM | disk | FTP | other *** search
/ The PC-SIG Library 10 / The PC-Sig Library - Shareware for the IBM PC and Compatibles (PC-SIG)(Tenth Edition Disks 1-2804)(1991).iso / PC_SIGCD / 04 / 4 / DISK0442.ZIP / PWARN.PAS < prev    next >
Pascal/Delphi Source File  |  1990-06-14  |  54KB  |  302 lines
  1.  PROGRAM WARNIER(INFLE,OUTFLE,PLIPUNCH,OUTDIAG,SRCPUNCH);
  2.   (*$M 32760,0,655360*)
  3.   USES DOS;
  4.   (*DECLARATIONS*)
  5.    CONST
  6.     NMDEL=13;MAXCPP=10;MAXNW=30;MAXPW=10;MAXLLO=160;
  7.      MAXLLIP1=161;MAXDEPTH=40;NBRSTRPGS=20;LENSTRPGS=5000;DDSTL=100;
  8.       (*CHARACTER CONSTANTS*)
  9.        REGZERO='0';CAPA='A';SMALLA='a';
  10.        HD1='ECHO OF INPUT  /  DIAGNOSTIC LOG';
  11.    TYPE
  12.     WPTRT=^WNODE;LPTRT=^LINEORD;QPTRT=^QEL;SPPTRT=^STRP;
  13.     (*MORE TYPES*)
  14.      VMT=PACKED ARRAY[1..MAXLLO] OF CHAR;
  15.      WORDT=PACKED ARRAY[1..9] OF CHAR;
  16.      STRPGTP=PACKED ARRAY[1..LENSTRPGS] OF CHAR;
  17.     TDSTRING = STRING[8];
  18.      CARDIMAGE=STRING[MAXLLIP1];
  19.     (*ARBITRARY DEEPENER*)
  20.      (*RECORD DECLARATIONS*)
  21.       (*WARNIER NODE DEFINITION*)
  22.        WNODE=PACKED RECORD
  23.         (*POINTER TO SUBPAGE QUEUE ELEMENT IN PAGINATION*)
  24.          SUBPAGE:QPTRT;
  25.  (*(NEXT LVL, BACK, NEXT BRO)WARNIER POINTERS,(LEFT,RIGHT)LEX PTRS*)
  26.          NLVL,BCK,NXT,LLINK,RLINK:WPTRT;
  27.         (*START,LOCAL START,(NODE,REP) STRING OFFSET,MAXMOVE*)
  28.          ST,LS,NDSOFF,RPSOFF,MXM:INTEGER;
  29.  (*LEN(PRE,VAL,INFX,REP,OUT),LVL,LINES/NODE,LCL DEPTH,(STR,REP)PGNO*)
  30.          LP,LV,LI,LR,LO,LVL,LPN,LD,SPN,RSPN:CHAR
  31.        END;
  32.       LINEORD=RECORD
  33.        (*CURRENT NODE OF COUSIN SET*)
  34.        WPTR:WPTRT;
  35.        (*NEXT SET OF COUSINS*)
  36.        NXTSC:LPTRT;
  37.        (*START POSITION, LAST POSITION IN LAYOUT*)
  38.        STARTP,LASTP:INTEGER
  39.       END (*LINEORD NODE DEFINITION*);
  40.       STRP=RECORD STRNG:STRPGTP;END (*STRP DEFINITION*);
  41.       (*PAGE QEL NODE DEFINITION *)
  42.        QEL=PACKED RECORD
  43.         (*DEWEY DECIMAL STRING*)
  44.          DDNSTR:STRING[DDSTL];
  45.         (*FORWARD AND BACKWARD IN QUEUE*)
  46.          NEXTQ,LASTQ:QPTRT;
  47.         (*POINTERS*)
  48.          SPPTR,NXTH,NLVLH:WPTRT;
  49.         (*FULLWORD HELD VALUES, PRIORITY*)
  50.          PRTY,LSPH,STSH,STPH,NDSOFFH:INTEGER;
  51.         (*BYTE HELD VALUES*)
  52.          LPH,LVH,LIH,LRH,LPNH,SPNH,LDPH,DDL:CHAR
  53.        END;
  54.      THREEDIG=STRING[3];
  55.      BRKCHRS=SET OF CHAR;
  56.    VAR
  57.     LNOEC,PCNTEC,GMXD,PCNT,NCT,LPCNT,NQ,GMXH,PASSCNT,
  58.      ECPL,COLPP,DGMPL,LPP,TOPM,LLO,LLOM4,LLI,LLIM4,LLIP1,CTRL,
  59.       TITLEN,LASTNQ,NODEWIDTH,PREWIDTH,NODEWPPW,NODEWPP3,
  60.        I,NDDN,CHDEL,GST,NQLIM,RETC,DISAMNO,NSP,LSP,FROFF,BROFF:INTEGER;
  61.     WHEAD,WLAST,H,TWPTR,T,WNTOP,FRPTR,BRPTR:WPTRT;
  62.     CPAGE:SPPTRT;
  63.     LOTOP:LPTRT;
  64.     QH,QR,FPORD,TPTR,QLTOP:QPTRT;
  65.     (*ARRAYS & STRINGS*)
  66.      KEYS:ARRAY[1..22] OF WORDT;
  67.      START,REAR:ARRAY[1..MAXCPP] OF LPTRT;
  68.      SPADDR:ARRAY[1..NBRSTRPGS] OF SPPTRT;
  69.      BP,NP,NNE,NBE:ARRAY[1..MAXCPP] OF INTEGER;
  70.      (*CHARACTER VARS*)
  71.       BLNW:STRING[MAXNW];
  72.       (*DEWEY DECIMAL HOLDERS*)
  73.        DDN,PDN:STRING[DDSTL];
  74.       HDRPC:STRING[24];
  75.       BACKREF:STRING[28];
  76.       CSTR:STRING[47];
  77.       CPN:THREEDIG;
  78.       (*MORE ARRAYS*)
  79.        CN1,CN2,CN3:STRING[60];
  80.        NOTITLE,EWD,LCEWD,SEEPG:PACKED ARRAY[1..24] OF CHAR;
  81.        TINFX,TREP:STRING[12];
  82.        TPRE:STRING[MAXPW];
  83.        D:STRING[8];
  84.       VBAR,TBR,BBR:PACKED ARRAY[1..3] OF CHAR;
  85.       TITLE,EWDL,LCEWDL,BLANKV,TVAL:VMT;
  86.       INCARD:CARDIMAGE;WORDVAR:WORDT;
  87.      MAXLEN:ARRAY[1..3] OF INTEGER;
  88.      MAXM,TOTWIDTH:ARRAY[1..MAXDEPTH] OF INTEGER;
  89.     BREAKERS,PRES,POSTS,INDIFFS:BRKCHRS;
  90.     TAB,ICH,COM,SEMI,PCT,PEJ,QOT,SUPERZERO,SUPERNINE:CHAR;
  91.     PLIFLAG,INDFLAG,SRCFLAG,PRINTABLE:BOOLEAN;
  92.     INFLE,OUTFLE,PLIPUNCH,OUTDIAG,SRCPUNCH:TEXT;
  93.   (*PROCEDURES*)
  94.    (*SUPPORT, STARTUP, INPUT*)
  95.     (*GENERAL SUPPORT ROUTINES*)
  96.      (*$I TIMEDATE.PAS*)
  97.      PROCEDURE CONVERT(I:INTEGER;VAR TPN:THREEDIG);
  98.       (*PRODUCE THREE DIGIT CHARACTER EQUIVALENT OF I*)
  99.       BEGIN
  100.        IF I>1000 THEN I:=I MOD 1000;
  101.         IF I>=100 THEN BEGIN
  102.          TPN[1]:=CHR(ORD(REGZERO)+I DIV 100);
  103.          TPN[2]:='0'; I:=I MOD 100
  104.         END
  105.         ELSE BEGIN
  106.          TPN[1]:=' '; TPN[2]:=' '
  107.         END;
  108.        IF I>=10 THEN BEGIN
  109.         TPN[2]:=CHR(ORD(REGZERO)+I DIV 10);
  110.         I:=I MOD 10
  111.        END;
  112.        TPN[3]:=CHR(ORD(REGZERO)+I)
  113.       END(*CONVERT SUBROUTINE*);
  114.      PROCEDURE OUTP;
  115.       (*ADVANCE LINENO, PAGINATE IN ECHOFILE*)
  116.       BEGIN
  117.        LNOEC:=SUCC(LNOEC);
  118.         IF LNOEC>ECPL THEN BEGIN
  119.          PCNTEC:=SUCC(PCNTEC);LNOEC:=3;
  120.          WRITELN(OUTDIAG,PEJ,HD1:32,' ':64,HDRPC,PCNTEC:3);
  121.          WRITELN(OUTDIAG,'     ')
  122.         END
  123.       END (*PROCEDURE OUTP*);
  124.      PROCEDURE NEWNODE;
  125.       BEGIN
  126.        IF WNTOP<>NIL THEN BEGIN
  127.         TWPTR:=WNTOP;WNTOP:=TWPTR^.NXT
  128.        END ELSE NEW(TWPTR);
  129.        (*INIT NODE*)
  130.         WITH TWPTR^ DO BEGIN
  131.          SUBPAGE:=NIL;NLVL:=NIL;BCK:=NIL;NXT:=NIL;
  132.          LLINK:=NIL;RLINK:=NIL;LD:=CHR(0);
  133.          LI:=CHR(0);LR:=CHR(0);RSPN:=CHR(0);RPSOFF:=0;LS:=0; MXM:=0;
  134.          SPN:=CHR(NSP);NDSOFF:=LSP
  135.         END;
  136.       END;
  137.     PROCEDURE INITIALIZE;BEGIN;
  138.      BACKREF:='**(REPEATED FROM PAGE000)** ';
  139.      SEEPG:='**SEE PAGE000**         ';
  140.      EWD:='ENDWARNIERDIAGRAM       ';
  141.      LCEWD:='endwarnierdiagram       ';
  142.      (*CHARACTERS*)
  143.       DDN:='ROOT                                              '+
  144.             '                                                  ';
  145.       HDRPC:='SPA:WN 1.5          PAGE';
  146.       NOTITLE:='UNTITLED WARNIER DIAGRAM';
  147.       (*XREFS,KEYS*)
  148.        KEYS[1]:='COMMA    ';KEYS[2]:='TITLE    ';KEYS[3]:='QUOTE    ';
  149.        (*TRAILERS*)
  150.  CN1:=' SPA:WN - STRUCTURED PROGRAMMING AUTOMATED: WARNIER NOTATION';
  151.  CN2:=' COPYRIGHT 1984, KSU RESEARCH FOUNDATION, MANHATTAN,KS 66506';
  152.  CN3:=' LICENSE GRANTED TO COPY, BUT NOT FOR SALE OR PROFIT        ';
  153.        KEYS[4] :='SEMI     ';KEYS[5] :='SRCPUNCH ';KEYS[6] :='PLIPUNCH ';
  154.        KEYS[7] :='SEMICOLON';KEYS[8] :='INDENT   ';KEYS[9] :='VERTBAR  ';
  155.        KEYS[10]:='PERCENT  ';KEYS[11]:='TOPBRACK ';
  156.        (*MORE KEYS*)
  157.  KEYS[12]:='BOTBRACK ';KEYS[13]:='DIAGCOLS ';KEYS[14]:='DIAGPAGEL';
  158.  KEYS[15]:='NODEWIDTH';KEYS[16]:='PREFWIDTH';KEYS[17]:='ECHOPAGEL';
  159.  KEYS[18]:='LINESPHYS';KEYS[19]:='TOPMARGIN';KEYS[20]:='LENLINOUT';
  160.        KEYS[21]:='LENLININ ';KEYS[22]:='         ';
  161.       CSTR:='MAYaGS4bcDJPV17.defBEHKNQTWZ258ghijCFILORUX0369';
  162.       VBAR:=' | ';
  163.       TBR:=' .-';BBR:=' ''-';
  164.       PEJ:=CHR(12);
  165.      ICH:=' ';COM:=',';SEMI:=';';PCT:='%';QOT:='"';
  166.      PCNTEC:=0;NDDN:=4
  167.     END;
  168.     (*INPUT PHASE ROUTINES*)
  169.      PROCEDURE INFILE(VAR INCARD:CARDIMAGE);
  170.       (*READ INPUT RECORD, SKIP COMMENTS*)
  171.       BEGIN
  172.        INCARD:=BLANKV;
  173.        READLN(INFLE,INCARD);
  174.        (*ASTERISK IN COLUMN 1 ==> SPA:WN COMMENT*)
  175.        WHILE INCARD[1]='*' DO BEGIN
  176.  OUTP;WRITELN(OUTDIAG,' ',COPY(INCARD,1,LLO));
  177.         IF SRCFLAG THEN WRITELN(SRCPUNCH,INCARD);
  178.          IF NOT INDFLAG THEN INCARD:=COPY(INCARD,2,LLI-1) ELSE
  179.          INCARD[1]:=' ';
  180.          IF PLIFLAG THEN WRITELN(PLIPUNCH,INCARD);
  181.          INCARD:=BLANKV;
  182.         READLN(INFLE,INCARD)
  183.        END
  184.       END(*OF INFILE PROCEDURE*);
  185.      PROCEDURE HEADERS;
  186.       VAR TOK:CHAR;HDRCARD:BOOLEAN;I,J:INTEGER;
  187.       PROCEDURE NUM(VAR VAL:INTEGER);BEGIN;
  188.        VAL:=ORD(TOK)-ORD(REGZERO);
  189.         IF (VAL<0) OR (VAL>9) THEN BEGIN
  190.  OUTP;WRITELN(OUTDIAG,' ***** NON-NUMERIC FOUND UNEXPECTEDLY: ',TOK);
  191.         END;
  192.        I:=SUCC(I);
  193.         WHILE INCARD[I]<>' ' DO BEGIN;
  194.          VAL:=VAL*10+ORD(INCARD[I])-ORD(REGZERO);
  195.          I:=SUCC(I)
  196.         END
  197.       END;
  198.       BEGIN
  199.        (*PARSE HEADER CARD(S)*)
  200.         HDRCARD:=TRUE;PRINTABLE:=TRUE;
  201.         WHILE HDRCARD DO BEGIN
  202.  OUTP;WRITELN(OUTDIAG,' ',COPY(INCARD,1,LLO));
  203.          NSP:=1; I:=1;
  204.          WHILE I<=LLI DO BEGIN
  205.           WHILE (I<=LLI) AND (INCARD[I]=' ') DO
  206.            I:=SUCC(I);
  207.           (*PARSE CONTROL CARD*)
  208.           IF I<=LLIM4 THEN BEGIN
  209.            J:=1;
  210.            WHILE(INCARD[I]<>' ') AND (J<=9) DO BEGIN
  211.             IF (INCARD[I]<='z') AND (INCARD[I]>=SMALLA) THEN
  212.              (*CAPITALIZE LETTERS OF KEYWORDS*)
  213.              WORDVAR[J]:=CHR(ORD(INCARD[I])+CHDEL)
  214.             ELSE WORDVAR[J]:=INCARD[I];
  215.             J:=SUCC(J);I:=SUCC(I)
  216.            END;
  217.            FOR J:=J TO 9 DO WORDVAR[J]:=' ';
  218.            WHILE((INCARD[I]=' ') AND (I<=LLI)) DO I:=SUCC(I);
  219.            IF I<=LLI THEN BEGIN
  220.             TOK:=INCARD[I];
  221.             J:=1;
  222.             WHILE(KEYS[J]<>WORDVAR)AND(J<=21)DO J:=SUCC(J);
  223.             CASE J OF
  224.              1:(*COMMA    *)COM:=TOK;
  225.              2:(*TITLE    *)BEGIN
  226.               J:=1;TITLE:=BLANKV;
  227.               IF SRCFLAG THEN WRITELN(SRCPUNCH,INCARD);
  228.               WHILE I<=LLI DO BEGIN
  229.                TITLE[J]:=INCARD[I];
  230.                IF TITLE[J]<>' ' THEN TITLEN:=J;
  231.                J:=SUCC(J);I:=SUCC(I)
  232.               END;
  233.               TITLE[J+2]:='/';TITLEN:=TITLEN+3;IF TITLEN<5 THEN TITLEN:=5
  234.              END;
  235.              3:(*QUOTE    *)QOT:=TOK;
  236.              4:(*SEMI     *)SEMI:=TOK;
  237.              (*OUTPUT OPTIONS*)
  238.               5:(*SRCPUNCH *)BEGIN
  239.                SRCFLAG:=((TOK='Y') OR (TOK='y'))
  240.               END;
  241.               6:(*PLIPUNCH *)PLIFLAG:=((TOK='Y') OR (TOK='y'));
  242.               8:(*INDENT   *)BEGIN
  243.                INDFLAG:=NOT((TOK='N') OR (TOK='n'));
  244.                IF ((TOK='Y') OR (TOK='y')) THEN ICH:=' '
  245.                ELSE ICH:=TOK
  246.               END;
  247.              7:(*SEMICOLON*)SEMI:=TOK;
  248.              9:(*VERTBAR  *)VBAR[2]:=TOK;
  249.              10:(*PERCENT  *)PCT:=TOK;
  250.              11:(*TOPBRACK *)BEGIN
  251.               TBR[2]:=TOK;TBR[3]:=' '
  252.              END;
  253.              12:(*BOTBRACK *)BEGIN
  254.               BBR[2]:=TOK;BBR[3]:=' '
  255.              END;
  256.              13:(*DIAGCOLS *)BEGIN;NUM(COLPP);
  257.               IF COLPP>MAXCPP THEN BEGIN
  258.  OUTP;WRITELN(OUTDIAG,' ***** DIAGCOLS VALUE EXCEEDS ',MAXCPP,
  259.                 ' EXPECT CRASH.')
  260.               END;
  261.              END;
  262.              14:(*DIAGPAGEL*)NUM(DGMPL);
  263.              (*DEEPEN THE LEVEL*)
  264.               15:(*NODEWIDTH*)BEGIN;NUM(NODEWIDTH);
  265.                IF NODEWIDTH>MAXNW THEN BEGIN
  266.  OUTP;WRITELN(OUTDIAG,' ***** NODEWIDTH VALUE EXCEEDS ',MAXNW,
  267.                 ' EXPECT CRASH.')
  268.                END
  269.               END;
  270.               16:(*PREFWIDTH*)BEGIN;NUM(PREWIDTH);
  271.                IF PREWIDTH>MAXPW THEN BEGIN
  272.  OUTP;WRITELN(OUTDIAG,' ***** PREWIDTH VALUE EXCEEDS ',MAXPW,
  273.                 ' EXPECT CRASH.')
  274.                END
  275.               END;
  276.               (*DEEPEN IT*)
  277.                17:(*ECHOPAGEL*)NUM(ECPL);
  278.                18:(*LINESPHYS*)NUM(LPP);
  279.               19:(*TOPMARGIN*)NUM(TOPM);
  280.               20:(*LENLINOUT*)BEGIN;NUM(LLO);
  281.                IF LLO>MAXLLO THEN BEGIN
  282.  OUTP;WRITELN(OUTDIAG,' ***** LENLINOUT VALUE EXCEEDS ',MAXLLO,
  283.                 ' EXPECT CRASH.')
  284.                END
  285.               END;
  286.              21:(*LENLININ *)BEGIN
  287.               NUM(LLI);LLIM4:=LLI-4
  288.              END;
  289.              22:(*OTHERWISE*)BEGIN
  290.               IF NSP=0 THEN BEGIN
  291.                OUTP;WRITELN(OUTDIAG,' ***** KEYWORD UNKNOWN: ',WORDVAR);
  292.               END;
  293.               I:=SUCC(LLI);HDRCARD:=FALSE
  294.              END
  295.             END(*CASE WORDVAR*);
  296.             I:=SUCC(I);
  297.             IF (I>LLI) AND HDRCARD THEN INFILE(INCARD)
  298.            END
  299.            ELSE HDRCARD:=FALSE
  300.           END
  301.           ELSE BEGIN
  302.            IF SRCFLAG THEN WRITELN(SRw